VERSION 5.00
Begin VB.UserControl ucGrid 
   Alignable       =   -1  'True
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   2370
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4095
   FillStyle       =   0  'Solid
   KeyPreview      =   -1  'True
   ScaleHeight     =   158
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   273
   Begin VB.HScrollBar scrHoriz 
      Height          =   255
      Left            =   0
      TabIndex        =   3
      Top             =   960
      Visible         =   0   'False
      Width           =   2295
   End
   Begin VB.VScrollBar scrVert 
      Height          =   975
      Left            =   2280
      TabIndex        =   2
      Top             =   0
      Width           =   255
   End
   Begin VB.PictureBox lblCorner 
      Appearance      =   0  'Flat
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   735
      Left            =   2280
      ScaleHeight     =   735
      ScaleWidth      =   855
      TabIndex        =   1
      Top             =   960
      Width           =   855
   End
   Begin VB.TextBox txtEdit 
      BorderStyle     =   0  'None
      Height          =   285
      Left            =   720
      TabIndex        =   0
      Top             =   240
      Visible         =   0   'False
      Width           =   1095
   End
   Begin VB.Line mLine1 
      BorderStyle     =   2  'Dash
      BorderWidth     =   2
      DrawMode        =   6  'Mask Pen Not
      Visible         =   0   'False
      X1              =   88
      X2              =   88
      Y1              =   8
      Y2              =   112
   End
End
Attribute VB_Name = "ucGrid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Const DT_TOP = &H0
Private Const DT_LEFT = &H0
Private Const DT_CENTER = &H1
Private Const DT_RIGHT = &H2
Private Const DT_VCENTER = &H4
Private Const DT_BOTTOM = &H8
Private Const DT_WORDBREAK = &H10
Private Const DT_SINGLELINE = &H20
Private Const DT_EXPANDTABS = &H40
Private Const DT_TABSTOP = &H80
Private Const DT_NOCLIP = &H100
Private Const DT_EXTERNALLEADING = &H200
Private Const DT_CALCRECT = &H400
Private Const DT_NOPREFIX = &H800
Private Const DT_INTERNAL = &H1000
Private Const DT_EDITCONTROL = &H2000
Private Const DT_PATH_ELLIPSIS = &H4000
Private Const DT_END_ELLIPSIS = &H8000
Private Const DT_MODIFYSTRING = &H10000
Private Const DT_RTLREADING = &H20000
Private Const DT_WORD_ELLIPSIS = &H40000
Private Type RECT
    Left                      As Long
    Top                       As Long
    Right                     As Long
    Bottom                    As Long
End Type
Private Type TCell
    Text                      As String
    IsData                    As Boolean
    Width                     As Long
    Height                    As Long
    FontBold                  As Boolean
    FontItalic                As Boolean
    FontUnderline             As Boolean
    FontName                  As String
    FontAlign                 As Byte
End Type
Public Enum EAlign
    Left = 0
    Center = 1
    Right = 2
End Enum
Public Enum ERowData
    UserDefined = 0
    Number = 1
    SelectedPointer = 2
End Enum
Private m_SelectedRect        As RECT
Private m_SelectedRow         As Long
Private m_SelectedCol         As Long
Private m_DrawedCols          As Long
Private m_DrawedRows          As Long
Private m_Focused             As Boolean
Private m_Editable            As Boolean
Private m_Sizeable            As Boolean
Private m_AutoAddRow          As Boolean
Private m_RowData             As ERowData
Private m_ResizeCol           As Long
Private m_ResizeRow           As Long
Private m_MouseDown           As Boolean
Private m_ResizeX             As Long
Private m_ResizeY             As Long
Private m_GridCol             As OLE_COLOR
Private m_GridColFix          As OLE_COLOR
Private m_ForeColor           As OLE_COLOR
Private m_ForeColorSel        As OLE_COLOR
Private m_ForeColorFixed      As OLE_COLOR
Private m_BackColor           As OLE_COLOR
Private m_BackColorContainer  As OLE_COLOR
Private m_BackColorFixed      As OLE_COLOR
Private m_BackColorSel        As OLE_COLOR
Private m_ColumnCount         As Long
Private m_RowCount            As Long
Private m_FirstCol            As Long
Private m_FirstRow            As Long
Private m_RowCountB           As Long
Private m_Array()             As TCell
Public Event Click(ByRef LastRow As Long, ByRef LastColumn As Long, ByRef NewRow As Long, ByRef NewColumn As Long)
Public Event DblClick()
Public Event ChangeData(ByRef ChangedRow As Long, ByRef ChangedColumn As Long)
Public Event MouseDown(ByRef Button As Integer, ByRef Shift As Integer, ByRef X As Single, ByRef Y As Single)
Public Event MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef X As Single, ByRef Y As Single)
Public Event MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef X As Single, ByRef Y As Single)
Public Event ScrollColumnsToEnd()
Public Event ScrollRowsToEnd()

Public Property Get RowFixedData() As ERowData
    RowFixedData = m_RowData
End Property

Public Property Let RowFixedData(ByVal Value As ERowData)
    m_RowData = Value
    Call DrawTable
End Property

Public Property Get Cols() As Long
    Cols = m_ColumnCount
End Property

Public Property Let Cols(ByVal Value As Long)
    If Value < 1 Then
        Err.Raise 380
    End If
    m_ColumnCount = Value
    Call SetArray
    Call DrawTable
End Property

Public Property Get Rows() As Long
    Rows = m_RowCount
End Property

Public Property Let Rows(ByVal Value As Long)
    If Value < 1 Then
        Err.Raise 380
    End If
    m_RowCount = Value
    Call SetArray
    Call DrawTable
End Property

Public Property Get Data(ByVal RowIdx As Long, ByVal ColIdx As Long) As Variant
    Data = m_Array(RowIdx, ColIdx).Text
End Property

Public Property Let Data(ByVal RowIdx As Long, ByVal ColIdx As Long, ByVal Value As Variant)
    If RowIdx < 0 Or RowIdx > m_RowCount Then
        Err.Raise 380
    ElseIf ColIdx < 0 Or ColIdx > m_ColumnCount Then
        Err.Raise 380
    End If
    If IsNull(Value) Then
        m_Array(RowIdx, ColIdx).Text = ""
    Else
        m_Array(RowIdx, ColIdx).Text = CStr(Value)
    End If
    If RowIdx = m_RowCount Then
        If m_AutoAddRow = True Then
            Call AddRow
        End If
    End If
    Call DrawTable
End Property

Public Property Get BackColor() As OLE_COLOR
    BackColor = m_BackColor
End Property

Public Property Let BackColor(ByVal Value As OLE_COLOR)
    m_BackColor = Value
    Call DrawTable
End Property

Public Property Get BackColorFixed() As OLE_COLOR
    BackColorFixed = m_BackColorFixed
End Property

Public Property Let BackColorFixed(ByVal Value As OLE_COLOR)
    m_BackColorFixed = Value
    Call DrawTable
End Property

Public Property Get BackColorSelected() As OLE_COLOR
    BackColorSelected = m_BackColorSel
End Property

Public Property Let BackColorSelected(ByVal Value As OLE_COLOR)
    m_BackColorSel = Value
    Call DrawTable
End Property

Public Property Get BackColorContainer() As OLE_COLOR
    BackColorContainer = m_BackColorContainer
End Property

Public Property Let BackColorContainer(ByVal Value As OLE_COLOR)
    m_BackColorContainer = Value
    Call DrawTable
End Property

Public Property Get ForeColor() As OLE_COLOR
    ForeColor = m_ForeColor
End Property

Public Property Let ForeColor(ByVal Value As OLE_COLOR)
    m_ForeColor = Value
    Call DrawTable
End Property

Public Property Get ForeColorFixed() As OLE_COLOR
    ForeColorFixed = m_ForeColorFixed
End Property

Public Property Let ForeColorFixed(ByVal Value As OLE_COLOR)
    m_ForeColorFixed = Value
    Call DrawTable
End Property

Public Property Get ForeColorSelected() As OLE_COLOR
    ForeColorSelected = m_ForeColorSel
End Property

Public Property Let ForeColorSelected(ByVal Value As OLE_COLOR)
    m_ForeColorSel = Value
    Call DrawTable
End Property

Public Property Get GridColor() As OLE_COLOR
    GridColor = m_GridCol
End Property

Public Property Let GridColor(ByVal Value As OLE_COLOR)
    m_GridCol = Value
    Call DrawTable
End Property

Public Property Get GridColorFixed() As OLE_COLOR
    GridColorFixed = m_GridColFix
End Property

Public Property Let GridColorFixed(ByVal Value As OLE_COLOR)
    m_GridColFix = Value
    Call DrawTable
End Property

Public Property Get Editable() As Boolean
    Editable = m_Editable
End Property

Public Property Let Editable(ByVal Value As Boolean)
    m_Editable = Value
    txtEdit.Visible = False
End Property

Public Property Get AutoAddNextRow() As Boolean
    AutoAddNextRow = m_AutoAddRow
End Property

Public Property Let AutoAddNextRow(ByVal Value As Boolean)
    m_AutoAddRow = Value
End Property

Public Property Get Sizable() As Boolean
    Sizable = m_Sizeable
End Property

Public Property Let Sizable(ByVal Value As Boolean)
    m_Sizeable = Value
End Property

Public Property Get Font() As StdFont
    Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal Value As StdFont)
    Set UserControl.Font = Value
    Call DrawTable
End Property

Public Property Get SelectedRow() As Long
    SelectedRow = m_SelectedRow
End Property

Public Property Let SelectedRow(ByVal Value As Long)
    m_SelectedRow = Value
    Call DrawTable
End Property

Public Property Get SelectedCol() As Long
    SelectedCol = m_SelectedCol
End Property

Public Property Let SelectedCol(ByVal Value As Long)
    m_SelectedCol = Value
    Call DrawTable
End Property

Public Property Get CellAlign(ByVal mRow As Long, ByVal mCol As Long) As EAlign
    If mRow < 0 Or mCol < 0 Then
        Err.Raise 380
    ElseIf mRow > m_RowCount Or mCol > m_ColumnCount Then
        Err.Raise 380
    End If
    CellAlign = m_Array(mRow, mCol).FontAlign
End Property

Public Property Let CellAlign(ByVal mRow As Long, ByVal mCol As Long, ByVal Value As EAlign)
    Dim val1 As Byte
    If mRow < 0 Or mCol < 0 Then
        Err.Raise 380
    ElseIf mRow > m_RowCount Or mCol > m_ColumnCount Then
        Err.Raise 380
    End If
    If Value = Left Then
        val1 = 0
    ElseIf Value = Center Then
        val1 = 2
    ElseIf Value = Right Then
        val1 = 1
    End If
    m_Array(mRow, mCol).FontAlign = Value
    If mRow = m_SelectedRow And mCol = m_SelectedCol Then
        txtEdit.Alignment = val1
    End If
    Call DrawTable
End Property

Public Property Get CellFontBold(ByVal mRow As Long, ByVal mCol As Long) As Boolean
    If mRow < 0 Or mCol < 0 Then
        Err.Raise 380
    ElseIf mRow > m_RowCount Or mCol > m_ColumnCount Then
        Err.Raise 380
    End If
    CellFontBold = m_Array(mRow, mCol).FontBold
End Property

Public Property Let CellFontBold(ByVal mRow As Long, ByVal mCol As Long, ByVal Value As Boolean)
    If mRow < 0 Or mCol < 0 Then
        Err.Raise 380
    ElseIf mRow > m_RowCount Or mCol > m_ColumnCount Then
        Err.Raise 380
    End If
    m_Array(mRow, mCol).FontBold = Value
    If mRow = m_SelectedRow And mCol = m_SelectedCol Then
        txtEdit.FontBold = Value
    End If
    Call DrawTable
End Property

Public Property Get CellFontItalic(ByVal mRow As Long, ByVal mCol As Long) As Boolean
    If mRow < 0 Or mCol < 0 Then
        Err.Raise 380
    ElseIf mRow > m_RowCount Or mCol > m_ColumnCount Then
        Err.Raise 380
    End If
    CellFontItalic = m_Array(mRow, mCol).FontItalic
End Property

Public Property Let CellFontItalic(ByVal mRow As Long, ByVal mCol As Long, ByVal Value As Boolean)
    If mRow < 0 Or mCol < 0 Then
        Err.Raise 380
    ElseIf mRow > m_RowCount Or mCol > m_ColumnCount Then
        Err.Raise 380
    End If
    m_Array(mRow, mCol).FontItalic = Value
    If mRow = m_SelectedRow And mCol = m_SelectedCol Then
        txtEdit.FontItalic = Value
    End If
    Call DrawTable
End Property

Public Property Get CellFontUnderline(ByVal mRow As Long, ByVal mCol As Long) As Boolean
    If mRow < 0 Or mCol < 0 Then
        Err.Raise 380
    ElseIf mRow > m_RowCount Or mCol > m_ColumnCount Then
        Err.Raise 380
    End If
    CellFontUnderline = m_Array(mRow, mCol).FontUnderline
End Property

Public Property Let CellFontUnderline(ByVal mRow As Long, ByVal mCol As Long, ByVal Value As Boolean)
    If mRow < 0 Or mCol < 0 Then
        Err.Raise 380
    ElseIf mRow > m_RowCount Or mCol > m_ColumnCount Then
        Err.Raise 380
    End If
    m_Array(mRow, mCol).FontUnderline = Value
    If mRow = m_SelectedRow And mCol = m_SelectedCol Then
        txtEdit.FontUnderline = Value
    End If
    Call DrawTable
End Property

Public Property Get CellFontName(ByVal mRow As Long, ByVal mCol As Long) As String
    If mRow < 0 Or mCol < 0 Then
        Err.Raise 380
    ElseIf mRow > m_RowCount Or mCol > m_ColumnCount Then
        Err.Raise 380
    End If
    CellFontName = m_Array(mRow, mCol).FontName
End Property

Public Property Let CellFontName(ByVal mRow As Long, ByVal mCol As Long, ByVal Value As String)
    If mRow < 0 Or mCol < 0 Then
        Err.Raise 380
    ElseIf mRow > m_RowCount Or mCol > m_ColumnCount Then
        Err.Raise 380
    End If
    m_Array(mRow, mCol).FontName = Value
    If mRow = m_SelectedRow And mCol = m_SelectedCol Then
        txtEdit.FontName = Value
    End If
    Call DrawTable
End Property

Public Property Get CellWidth(ByVal mRow As Long, ByVal mCol As Long) As Long
    If mRow < 0 Or mCol < 0 Then
        Err.Raise 380
    ElseIf mRow > m_RowCount Or mCol > m_ColumnCount Then
        Err.Raise 380
    End If
    CellWidth = m_Array(mRow, mCol).Width
End Property

Public Property Let CellWidth(ByVal mRow As Long, ByVal mCol As Long, ByVal Value As Long)
    If mRow < 0 Or mCol < 0 Then
        Err.Raise 380
    ElseIf mRow > m_RowCount Or mCol > m_ColumnCount Then
        Err.Raise 380
    ElseIf Value < 5 Then
        Err.Raise 380
    End If
    m_Array(mRow, mCol).Width = Value
    Call DrawTable
End Property

Public Property Get CellHeight(ByVal mRow As Long, ByVal mCol As Long) As Long
    If mRow < 0 Or mCol < 0 Then
        Err.Raise 380
    ElseIf mRow > m_RowCount Or mCol > m_ColumnCount Then
        Err.Raise 380
    End If
    CellHeight = m_Array(mRow, mCol).Height
End Property

Public Property Let CellHeight(ByVal mRow As Long, ByVal mCol As Long, ByVal Value As Long)
    If mRow < 0 Or mCol < 0 Then
        Err.Raise 380
    ElseIf mRow > m_RowCount Or mCol > m_ColumnCount Then
        Err.Raise 380
    ElseIf Value < 5 Then
        Err.Raise 380
    End If
    m_Array(mRow, mCol).Height = Value
    Call DrawTable
End Property

Private Sub SetArray()
    m_FirstCol = 1
    m_FirstRow = 1
    m_RowCountB = m_RowCount + 50
    ReDim m_Array(m_RowCountB, m_ColumnCount)
    Call SetDefValues(0)
End Sub

Private Sub SetDefValues(Optional FirstRow As Long = 0)
    Dim i As Long, j As Long
    For i = FirstRow To m_RowCount
        For j = 0 To m_ColumnCount
            With m_Array(i, j)
                .Text = ""
                If j > 0 Then
                    .IsData = True
                Else
                    .IsData = False
                End If
                If j = 0 Then
                    .FontAlign = 1
                Else
                    .FontAlign = 1
                End If
                .FontBold = UserControl.Font.Bold
                .FontItalic = UserControl.Font.Italic
                .FontName = UserControl.Font.Name
                .FontUnderline = UserControl.Font.Underline
                .Height = 20
                .Width = 70
            End With
        Next j
    Next i
End Sub

Private Sub DrawTable()
    Dim rowDataPrint As String
    Dim mX As Long, mY  As Long
    Dim i As Long, j As Long
    Dim mRect As RECT
    m_DrawedCols = 0
    m_DrawedRows = 0
    With UserControl
        .Cls
        .BackColor = m_BackColorContainer
        .txtEdit.BackColor = m_BackColorSel
        .txtEdit.ForeColor = m_ForeColorSel
        .FillColor = m_BackColor
        .ForeColor = m_ForeColor
    End With
    mY = m_Array(0, 0).Height
    For i = m_FirstRow To m_RowCount
        mX = m_Array(0, 0).Width
        For j = m_FirstCol To m_ColumnCount
            With UserControl
                .Font.Bold = m_Array(i, j).FontBold
                .Font.Italic = m_Array(i, j).FontItalic
                If m_Array(i, j).FontName <> "" Then
                    .Font.Name = m_Array(i, j).FontName
                End If
                .Font.Underline = m_Array(i, j).FontUnderline
            End With
            If i <> m_SelectedRow Or j <> m_SelectedCol Then
                UserControl.FillColor = m_BackColor
                UserControl.ForeColor = m_ForeColor
            Else
                UserControl.FillColor = m_BackColorSel
                UserControl.ForeColor = m_ForeColorSel
                m_SelectedRect.Left = mX
                m_SelectedRect.Right = mX + m_Array(0, j).Width
                m_SelectedRect.Top = mY
                m_SelectedRect.Bottom = mY + m_Array(i, 0).Height
            End If
            With mRect
                .Left = mX + 2
                .Top = mY + 2
                .Right = mX + m_Array(0, j).Width - 2
                .Bottom = mY + m_Array(0, 0).Height - 2
            End With
            UserControl.Line (mX, mY)-(mX + m_Array(0, j).Width, mY + m_Array(i, 0).Height), m_GridCol, B
            mX = mX + m_Array(0, j).Width
            If mX > UserControl.ScaleWidth Then
                Exit For
            End If
            Select Case m_Array(i, j).FontAlign
                Case 0
                    Call DrawText(UserControl.hdc, m_Array(i, j).Text, -1, mRect, DT_LEFT Or DT_VCENTER)
                Case 1
                    Call DrawText(UserControl.hdc, m_Array(i, j).Text, -1, mRect, DT_CENTER Or DT_VCENTER)
                Case 2
                    Call DrawText(UserControl.hdc, m_Array(i, j).Text, -1, mRect, DT_RIGHT Or DT_VCENTER)
            End Select
        Next j
        mY = mY + m_Array(i, 0).Height
        If mY > UserControl.ScaleHeight Then Exit For
    Next
    mX = 0
    mY = 0
    UserControl.FillColor = m_BackColorFixed
    UserControl.ForeColor = m_ForeColorFixed
    For i = 0 To m_ColumnCount
        m_DrawedCols = m_DrawedCols + 1
        If i = 1 Then
            i = m_FirstCol
        End If
        With UserControl
            .Font.Bold = m_Array(0, i).FontBold
            .Font.Italic = m_Array(0, i).FontItalic
            .Font.Name = m_Array(0, i).FontName
            .Font.Underline = m_Array(0, i).FontUnderline
        End With
        With mRect
            .Left = mX + 2
            .Top = mY + 2
            .Right = mX + m_Array(0, i).Width - 2
            .Bottom = mY + m_Array(0, 0).Height - 2
        End With
        UserControl.Line (mX, mY)-(mX + m_Array(0, i).Width, mY + m_Array(0, 0).Height), m_GridColFix, B
        mX = mX + m_Array(0, i).Width
        Select Case m_Array(0, i).FontAlign
            Case 0
                Call DrawText(UserControl.hdc, m_Array(0, i).Text, -1, mRect, DT_LEFT Or DT_VCENTER)
            Case 1
                Call DrawText(UserControl.hdc, m_Array(0, i).Text, -1, mRect, DT_CENTER Or DT_VCENTER)
            Case 2
                Call DrawText(UserControl.hdc, m_Array(0, i).Text, -1, mRect, DT_RIGHT Or DT_VCENTER)
        End Select
        If mX > UserControl.ScaleWidth - UserControl.scrVert.Width Then
            m_DrawedCols = m_DrawedCols - 1
            Exit For
        End If
    Next i
    mX = 0
    mY = m_Array(0, 0).Height
    For i = m_FirstRow To m_RowCount
        m_DrawedRows = m_DrawedRows + 1
        With UserControl
            .Font.Bold = m_Array(i, 0).FontBold
            .Font.Italic = m_Array(i, 0).FontItalic
            If m_Array(i, 0).FontName <> "" Then
                .Font.Name = m_Array(i, 0).FontName
            End If
            .Font.Underline = m_Array(i, 0).FontUnderline
        End With
        With mRect
            .Left = mX + 2
            .Top = mY + 2
            .Right = mX + m_Array(0, 0).Width - 2
            .Bottom = mY + m_Array(i, 0).Height - 2
        End With
        UserControl.Line (mX, mY)-(mX + m_Array(0, 0).Width, mY + m_Array(i, 0).Height), m_GridColFix, B
        mY = mY + m_Array(i, 0).Height
        If m_RowData = UserDefined Then
            rowDataPrint = m_Array(i, 0).Text
        ElseIf m_RowData = SelectedPointer Then
            If i = m_SelectedRow And i > 0 Then
                rowDataPrint = "*"
            Else
                rowDataPrint = vbNullString
            End If
        ElseIf m_RowData = Number Then
            If i > 0 Then
                rowDataPrint = Str$(i)
            Else
                rowDataPrint = vbNullString
            End If
        End If
        Select Case m_Array(i, 0).FontAlign
            Case 0
                Call DrawText(UserControl.hdc, rowDataPrint, -1, mRect, DT_LEFT Or DT_VCENTER)
            Case 1
                Call DrawText(UserControl.hdc, rowDataPrint, -1, mRect, DT_CENTER Or DT_VCENTER)
            Case 2
                Call DrawText(UserControl.hdc, rowDataPrint, -1, mRect, DT_RIGHT Or DT_VCENTER)
        End Select
        If mY > UserControl.ScaleHeight - UserControl.scrHoriz.Height Then
            m_DrawedRows = m_DrawedRows - 1
            Exit For
        End If
    Next
    With UserControl
        If m_DrawedCols - 1 < m_ColumnCount Then
            .scrHoriz.Enabled = True
            .scrHoriz.Min = 1
            .scrHoriz.Max = m_ColumnCount
            .scrHoriz.Value = m_FirstCol
        Else
            .scrHoriz.Enabled = False
        End If
        If m_DrawedRows < m_RowCount Then
            .scrVert.Enabled = True
            .scrVert.Min = 1
            .scrVert.Max = m_RowCount
            .scrVert.Value = m_FirstRow
        Else
            .scrVert.Enabled = False
        End If
    End With
End Sub

Private Sub prv_setEditingBox()
    If m_Editable = True Then
        If m_Array(m_SelectedRow, m_SelectedCol).IsData = True Then
            With txtEdit
                .Left = m_SelectedRect.Left + 2
                .Top = m_SelectedRect.Top + 2
                .Height = m_SelectedRect.Bottom - m_SelectedRect.Top - 2
                .Width = m_SelectedRect.Right - m_SelectedRect.Left - 2
                .Text = m_Array(m_SelectedRow, m_SelectedCol).Text
                .SelStart = 0
                .SelLength = Len(.Text)
                .Visible = True
                .SetFocus
                .Font.Bold = m_Array(m_SelectedRow, m_SelectedCol).FontBold
                .Font.Name = m_Array(m_SelectedRow, m_SelectedCol).FontName
                .Font.Italic = m_Array(m_SelectedRow, m_SelectedCol).FontItalic
                .Font.Underline = m_Array(m_SelectedRow, m_SelectedCol).FontUnderline
            End With
        End If
    End If
End Sub

Public Sub AddRow()
    Dim arr_tmp() As TCell
    Dim i As Long, j As Long
    m_RowCount = m_RowCount + 1
    If m_RowCountB < m_RowCount Then
        ReDim arr_tmp(m_RowCount, m_ColumnCount)
        For i = 0 To m_RowCount - 1
            For j = 0 To m_ColumnCount
                arr_tmp(i, j) = m_Array(i, j)
            Next j
        Next i
        m_RowCountB = m_RowCount + 50
        ReDim m_Array(m_RowCountB, m_ColumnCount)
        For i = 0 To m_RowCount - 1
            For j = 0 To m_ColumnCount
                m_Array(i, j) = arr_tmp(i, j)
            Next j
        Next i
    End If
    Call SetDefValues(m_RowCount)
    Call DrawTable
    Erase arr_tmp
    DoEvents
End Sub

Public Sub AddColumn()
    Dim i As Long
    m_ColumnCount = m_ColumnCount + 1
    ReDim Preserve m_Array(m_RowCountB, m_ColumnCount)
    For i = 0 To m_RowCount
        m_Array(i, m_ColumnCount).FontName = UserControl.Font.Name
        If i > 0 Then
            m_Array(i, m_ColumnCount).IsData = True
        Else
            m_Array(i, m_ColumnCount).IsData = False
        End If
        m_Array(i, m_ColumnCount).Height = 20
        m_Array(i, m_ColumnCount).Width = 70
    Next i
    Call DrawTable
    DoEvents
End Sub

Private Sub scrHoriz_Change()
    On Error Resume Next
    m_FirstCol = scrHoriz.Value
    Call DrawTable
    txtEdit.Visible = False
    lblCorner.SetFocus
    If scrHoriz.Value = scrHoriz.Max Then
        RaiseEvent ScrollColumnsToEnd
    End If
End Sub

Private Sub scrHoriz_Scroll()
    scrHoriz_Change
End Sub

Private Sub scrVert_Change()
    On Error Resume Next
    m_FirstRow = scrVert.Value
    Call DrawTable
    txtEdit.Visible = False
    lblCorner.SetFocus
    If scrVert.Value = scrVert.Max Then
        RaiseEvent ScrollRowsToEnd
    End If
End Sub

Private Sub scrVert_Scroll()
    scrVert_Change
End Sub

Private Sub txtEdit_GotFocus()
    m_Focused = True
End Sub

Private Sub txtEdit_LostFocus()
    m_Focused = False
End Sub

Private Sub txtEdit_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode < 37 Or KeyCode > 40 Then
        m_Array(m_SelectedRow, m_SelectedCol).Text = txtEdit.Text
        If m_SelectedRow = m_RowCount Then
            If m_AutoAddRow = True Then
                Call AddRow
            End If
        End If
        RaiseEvent ChangeData(m_SelectedRow, m_SelectedCol)
    End If
End Sub

Private Sub UserControl_DblClick()
    RaiseEvent DblClick
End Sub

Private Sub UserControl_Initialize()
    m_SelectedRow = 0
    m_SelectedRow = 0
    m_FirstCol = 1
    m_FirstRow = 1
    m_ColumnCount = 5
    m_RowCount = 5
    m_GridCol = &HC0C0C0
    m_GridColFix = &H808080
    m_ForeColor = vbBlack
    m_ForeColorSel = vbBlack
    m_ForeColorFixed = vbBlack
    m_BackColor = vbWhite
    m_BackColorSel = vbWhite
    m_BackColorFixed = vbButtonFace
    m_BackColorContainer = vbApplicationWorkspace
    m_Editable = True
    m_Sizeable = True
    m_AutoAddRow = True
    m_RowData = SelectedPointer
    Call SetArray
    Call DrawTable
End Sub

Private Function prv_getColFromPos(ByVal x_pos As Long) As Long
    Dim i As Long, mX As Long
    mX = 0
    If x_pos >= mX Then
        If x_pos <= mX + m_Array(0, i).Width Then
            m_SelectedRect.Left = mX
            m_SelectedRect.Right = mX + m_Array(0, i).Width
            prv_getColFromPos = i
            Exit Function
        End If
        mX = mX + m_Array(0, i).Width
    End If
    mX = m_Array(0, 0).Width
    For i = m_FirstCol To m_ColumnCount
        If x_pos >= mX Then
            If x_pos <= mX + m_Array(0, i).Width Then
                m_SelectedRect.Left = mX
                m_SelectedRect.Right = mX + m_Array(0, i).Width
                prv_getColFromPos = i
                Exit Function
            End If
            mX = mX + m_Array(0, i).Width
        End If
    Next i
    prv_getColFromPos = -1
End Function

Private Function GetColForResize(ByVal x_pos As Long) As Long
    Dim i As Long, mX As Long
    mX = 0
    i = 0
    If x_pos >= mX Then
        If x_pos <= mX + m_Array(0, i).Width + 2 Then
            If x_pos >= mX + m_Array(0, i).Width - 2 Then
                GetColForResize = i
                m_ResizeX = mX
            Else
                GetColForResize = -1
            End If
            Exit Function
        End If
    End If
    mX = m_Array(0, 0).Width
    For i = m_FirstCol To m_ColumnCount
        If x_pos >= mX Then
            If x_pos <= mX + m_Array(0, i).Width + 2 Then
                If x_pos >= mX + m_Array(0, i).Width - 2 Then
                    GetColForResize = i
                    m_ResizeX = mX
                Else
                    GetColForResize = -1
                End If
                Exit Function
            End If
            mX = mX + m_Array(0, i).Width
        End If
    Next i
    GetColForResize = -1
End Function

Private Function GetRowFromPos(ByVal y_pos As Long) As Long
    Dim i As Long, mY As Long
    mY = 0
    If y_pos >= mY Then
        If y_pos <= mY + m_Array(i, 0).Height Then
            m_SelectedRect.Top = mY
            m_SelectedRect.Bottom = mY + m_Array(i, 0).Height
            GetRowFromPos = i
            Exit Function
        End If
        mY = mY + m_Array(i, 0).Height
    End If
    mY = m_Array(0, 0).Height
    For i = m_FirstRow To m_RowCount
        If y_pos >= mY Then
            If y_pos <= mY + m_Array(i, 0).Height Then
                m_SelectedRect.Top = mY
                m_SelectedRect.Bottom = mY + m_Array(i, 0).Height
                GetRowFromPos = i
                Exit Function
            End If
            mY = mY + m_Array(i, 0).Height
        End If
    Next i
    GetRowFromPos = -1
End Function

Private Function GetRowForResize(ByVal y_pos As Long) As Long
    Dim i As Long, mY As Long
    mY = 0
    i = 0
    If y_pos >= mY Then
        If y_pos <= mY + m_Array(i, 0).Height + 2 Then
            If y_pos >= mY + m_Array(i, 0).Height - 2 Then
                GetRowForResize = i
                m_ResizeY = mY
            Else
                GetRowForResize = -1
            End If
            Exit Function
        End If
    End If
    mY = m_Array(0, 0).Height
    For i = m_FirstRow To m_RowCount
        If y_pos >= mY Then
            If y_pos <= mY + m_Array(i, 0).Height + 2 Then
                If y_pos >= mY + m_Array(i, 0).Height - 2 Then
                    GetRowForResize = i
                    m_ResizeY = mY
                Else
                    GetRowForResize = -1
                End If
                Exit Function
            End If
            mY = mY + m_Array(i, 0).Height
        End If
    Next i
    GetRowForResize = -1
End Function

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyLeft Then
        If m_SelectedCol > 1 Then
            If txtEdit.Visible = True Then
                If txtEdit.SelStart <= 1 Or txtEdit.SelLength > 0 Then
                    txtEdit.Visible = False
                    m_SelectedCol = m_SelectedCol - 1
                    txtEdit.Text = m_Array(m_SelectedRow, m_SelectedCol).Text
                    Call DrawTable
                    Call prv_setEditingBox
                End If
            Else
                m_SelectedCol = m_SelectedCol - 1
                txtEdit.Text = m_Array(m_SelectedRow, m_SelectedCol).Text
                Call DrawTable
                Call prv_setEditingBox
            End If
        End If
    ElseIf KeyCode = vbKeyRight Then
        If m_SelectedCol < m_ColumnCount Then
            If txtEdit.Visible = True Then
                If txtEdit.SelStart = Len(txtEdit.Text) Or txtEdit.SelLength > 0 Then
                    txtEdit.Visible = False
                    m_SelectedCol = m_SelectedCol + 1
                    txtEdit.Text = m_Array(m_SelectedRow, m_SelectedCol).Text
                    Call DrawTable
                    Call prv_setEditingBox
                End If
            Else
                m_SelectedCol = m_SelectedCol + 1
                txtEdit.Text = m_Array(m_SelectedRow, m_SelectedCol).Text
                Call DrawTable
                Call prv_setEditingBox
            End If
        End If
    ElseIf KeyCode = vbKeyUp Then
        If m_SelectedRow > 1 Then
            txtEdit.Visible = False
            m_SelectedRow = m_SelectedRow - 1
            txtEdit.Text = m_Array(m_SelectedRow, m_SelectedCol).Text
            Call DrawTable
            Call prv_setEditingBox
        End If
    ElseIf KeyCode = vbKeyDown Then
        If m_SelectedRow < m_RowCount Then
            txtEdit.Visible = False
            m_SelectedRow = m_SelectedRow + 1
            txtEdit.Text = m_Array(m_SelectedRow, m_SelectedCol).Text
            Call DrawTable
            Call prv_setEditingBox
        End If
    End If
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If m_ResizeCol > -1 Or m_ResizeRow > -1 Then
        If m_Sizeable = True Then
            m_MouseDown = True
        End If
    End If
    RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With UserControl
        If m_MouseDown = False Then
            m_ResizeCol = GetColForResize(X)
            m_ResizeRow = GetRowForResize(Y)
            If m_ResizeCol > -1 Then
                If m_Sizeable Then .MousePointer = 9
                m_ResizeRow = -1
            ElseIf m_ResizeRow > -1 Then
                If m_Sizeable Then .MousePointer = 7
            Else
                .MousePointer = 0
            End If
        Else
            If m_ResizeCol > -1 Then
                .mLine1.X1 = X
                .mLine1.X2 = X
                .mLine1.Y1 = 0
                .mLine1.Y2 = m_Array(0, 0).Height
                .mLine1.Visible = True
                If X - m_ResizeX > 10 Then
                    m_Array(0, m_ResizeCol).Width = X - m_ResizeX
                End If
            ElseIf m_ResizeRow > -1 Then
                .mLine1.X1 = 0
                .mLine1.X2 = m_Array(0, 0).Width
                .mLine1.Y1 = Y
                .mLine1.Y2 = Y
                .mLine1.Visible = True
                If Y - m_ResizeY > 10 Then
                    m_Array(m_ResizeRow, 0).Height = Y - m_ResizeY
                End If
            End If
        End If
    End With
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim old_row As Long, old_col As Long
    If m_MouseDown = True Then
        m_MouseDown = False
        mLine1.Visible = False
        txtEdit.Visible = False
    Else
        old_row = m_SelectedRow
        old_col = m_SelectedCol
        m_SelectedRow = GetRowFromPos(Y)
        m_SelectedCol = prv_getColFromPos(X)
        RaiseEvent Click(old_row, old_col, m_SelectedRow, m_SelectedCol)
        txtEdit.Visible = False
        If m_Editable = True Then
            If m_SelectedRow > 0 And m_SelectedCol > 0 Then
                If m_Array(m_SelectedRow, m_SelectedCol).IsData = True Then
                    With txtEdit
                        .Left = m_SelectedRect.Left + 2
                        .Top = m_SelectedRect.Top + 2
                        .Height = m_SelectedRect.Bottom - m_SelectedRect.Top - 2
                        .Width = m_SelectedRect.Right - m_SelectedRect.Left - 2
                        .Text = m_Array(m_SelectedRow, m_SelectedCol).Text
                        .SelStart = 0
                        .SelLength = Len(.Text)
                        .Visible = True
                        .SetFocus
                        .Font.Bold = m_Array(m_SelectedRow, m_SelectedCol).FontBold
                        .Font.Name = m_Array(m_SelectedRow, m_SelectedCol).FontName
                        .Font.Italic = m_Array(m_SelectedRow, m_SelectedCol).FontItalic
                        .Font.Underline = m_Array(m_SelectedRow, m_SelectedCol).FontUnderline
                    End With
                End If
            End If
        End If
    End If
    Call DrawTable
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub UserControl_Resize()
    With UserControl
        If .scrVert.Visible Then
            .scrHoriz.Top = .ScaleHeight - .scrHoriz.Height
            .scrHoriz.Width = .ScaleWidth - .scrVert.Width
        Else
            .scrHoriz.Top = .ScaleHeight - .scrHoriz.Height
            .scrHoriz.Width = .ScaleWidth
        End If
        If .scrHoriz.Visible Then
            .scrVert.Left = .ScaleWidth - .scrVert.Width
            .scrVert.Height = .ScaleHeight - .scrHoriz.Height
        Else
            .scrVert.Left = .ScaleWidth - .scrVert.Width
            .scrVert.Height = .ScaleHeight
        End If
        .lblCorner.Left = .scrHoriz.Width
        .lblCorner.Top = .scrVert.Height
    End With
    Call DrawTable
End Sub

Private Sub UserControl_Terminate()
    Erase m_Array
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    With PropBag
        m_RowCount = .ReadProperty("Rows", 5)
        m_ColumnCount = .ReadProperty("Cols", 5)
        m_BackColor = .ReadProperty("BackColor", vbWhite)
        m_BackColorFixed = .ReadProperty("BackColorFixed", vbButtonFace)
        m_BackColorSel = .ReadProperty("BackColorSelected", vbWhite)
        m_BackColorContainer = .ReadProperty("BackColorContainer", vbApplicationWorkspace)
        m_ForeColor = .ReadProperty("ForeColor", vbBlack)
        m_ForeColorFixed = .ReadProperty("ForeColorFixed", vbBlack)
        m_ForeColorSel = .ReadProperty("ForeColorSelected", vbBlack)
        m_GridCol = .ReadProperty("GridColor", &HC0C0C0)
        m_GridColFix = .ReadProperty("GridColorFixed", &H808080)
        m_Editable = .ReadProperty("Editable", True)
        m_Sizeable = .ReadProperty("Sizable", True)
        m_AutoAddRow = .ReadProperty("AutoAddNextRow", True)
        m_RowData = .ReadProperty("RowFixedData", 2)
        Set Font = .ReadProperty("Font", Ambient.Font)
    End With
    Call SetArray
    Call DrawTable
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    With PropBag
        .WriteProperty "Rows", m_RowCount, 5
        .WriteProperty "Cols", m_ColumnCount, 5
        .WriteProperty "BackColor", m_BackColor, vbWhite
        .WriteProperty "BackColorFixed", m_BackColorFixed, vbButtonFace
        .WriteProperty "BackColorSelected", m_BackColorSel, vbWhite
        .WriteProperty "BackColorContainer", m_BackColorContainer, vbApplicationWorkspace
        .WriteProperty "ForeColor", m_ForeColor, vbBlack
        .WriteProperty "ForeColorFixed", m_ForeColorFixed, vbBlack
        .WriteProperty "ForeColorSelected", m_ForeColorSel, vbBlack
        .WriteProperty "GridColor", m_GridCol, &HC0C0C0
        .WriteProperty "GridColorFixed", m_GridColFix, &H808080
        .WriteProperty "Editable", m_Editable, True
        .WriteProperty "Sizable", m_Sizeable, True
        .WriteProperty "AutoAddNextRow", m_AutoAddRow, True
        .WriteProperty "RowFixedData", m_RowData, 2
        .WriteProperty "Font", Font, Ambient.Font
    End With
End Sub

